SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00007 1 05-25-9408:00ALL MICHAEL HOENIE Loading .BMP SWAG9405 27 Kx {************************************************}π{ }π{ Turbo Pascal for Windows }π{ Demo unit }π{ Copyright (c) 1991 by Borland International }π{ }π{************************************************}ππ{$R-}ππunit LoadBMPs;ππinterfaceππuses WinProcs, WinTypes, Strings, WinDos;π { ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ I do not have these units!!! }ππfunction LoadBMP(Name: PChar; Window: hWnd; var DibPal: Word;π var Width, Height: LongInt): hBitMap;ππimplementationππfunction CreateBIPalette(BI: PBitMapInfoHeader): HPalette;πtypeπ ARGBQuad = Array[1..5000] of TRGBQuad;πvarπ RGB: ^ARGBQuad;π NumColors: Word;π Pal: PLogPalette;π hPal: hPalette;π I: Integer;πbeginπ CreateBiPalette := 0;π RGB := Ptr(Seg(BI^), Ofs(BI^)+BI^.biSize);π if BI^.biBitCount<24 thenπ beginπ NumColors:= 1 shl BI^.biBitCount;π if NumColors<>0 thenπ beginπ GetMem(Pal, SizeOf(PLogPalette)+NumColors*SizeOf(TPaletteEntry));π Pal^.palNumEntries := NumColors;π Pal^.palVersion := $300;π for I := 0 to NumColors-1 doπ beginπ Pal^.palPalEntry[I].peRed := RGB^[I].rgbRed;π Pal^.palPalEntry[I].peGreen := RGB^[I].rgbGreen;π Pal^.palPalEntry[I].peBlue := RGB^[I].rgbBlue;π Pal^.palPalEntry[I].peFlags := 0;π end;π hPal := CreatePalette(Pal^);π FreeMem(Pal, SizeOf(PLogPalette) + NumColors * SizeOf(TPaletteEntry));π CreateBiPalette := hPal;π end;π end;πend;ππfunction LoadBMP(Name: PChar; Window: hWnd; var DibPal: Word;π var Width, Height: LongInt): hBitMap;πvarπ BitMapFileHeader: TBitMapFileHeader;π DibSize, ReadSize, ColorTableSize, TempReadSize: LongInt;π DIB: PBitMapInfoHeader;π TempDib: Pointer;π Bits: Pointer;π F: File;π BitMap: hBitMap;π Handle: Word;π DC: hDC;π OldCursor: HCursor;πbeginπ Assign(F, Name);π {$I-}Reset(F, 1);{$I+}π if IOResult<>0 thenπ beginπ LoadBMP := 0;π Exit;π end;π OldCursor := SetCursor(LoadCursor(0, IDC_Wait));π BlockRead(F, BitMapFileHeader, SizeOf(BitMapFileHeader));π DibSize := BitMapFileHeader.bfSize - BitMapFileHeader.bfOffBits;π ReadSize := LongInt(BitMapFileHeader.bfSize) - SizeOf(BitMapFileHeader);π Handle := GlobalAlloc(GMem_Moveable, ReadSize);π DIB := GlobalLock(Handle);π TempReadSize := ReadSize;π TempDib := Dib;π while TempReadSize > 0 doπ beginπ if TempReadSize > $8000 thenπ beginπ BlockRead(F, TempDIB^, $8000);π if Ofs(TempDib^) = $8000 thenπ TempDib := Ptr(Seg(TempDib^) + 8, 0)π elseπ TempDib := Ptr(Seg(TempDib^), $8000);π endπ elseπ BlockRead(F, TempDIB^, TempReadSize);π Dec(TempReadSize, $8000);π end;π if DIB^.biBitCount = 24 thenπ ColorTableSize := 0π elseπ ColorTableSize := LongInt(1) shl DIB^.biBitCount * SizeOf(TRGBQuad);π Bits := Ptr(Seg(DIB^), Ofs(DIB^) + DIB^.biSize + ColorTableSize);π Close(F);π DC := GetDC(Window);π DibPal := CreateBIPalette(DIB);π if DibPal = 0 thenπ beginπ SelectPalette(DC, DibPal, false);π RealizePalette(DC);π end;π BitMap := CreateDIBitMap(DC, DIB^, cbm_Init, Bits, PBitMapInfo(Dib)^,π dib_RGB_Colors);π Height := DIB^.biHeight;π Width := DIB^.biWidth;π ReleaseDC(Window, DC);π GlobalUnLock(Handle);π GlobalFree(Handle);π LoadBMP := BitMap;π SetCursor(OldCursor);πend;ππend.π 2 05-25-9408:10ALL DOUG WEGSCHEID Extended GetDriveType SWAG9405 61 Kx (*π Extended GetDriveType for Windows 3.0/3.1.ππ Code ported the C in Microsoft PSS document Q105922.ππ Doug Wegscheid 3/22/94.π*)ππ{$DEFINE TEST} { undefine to make a unit }ππ{$IFDEF TEST}πprogram drivetyp;πuses wincrt, windos, winprocs, wintypes;π{$ELSE TEST}πunit drivetyp;ππinterfaceπ{$ENDIF}ππ{ Return values of GetDriveTypeEx(). }πconstπ EX_DRIVE_INVALID = 0;π EX_DRIVE_REMOVABLE = 1;π EX_DRIVE_FIXED = 2;π EX_DRIVE_REMOTE = 3;π EX_DRIVE_CDROM = 4;π EX_DRIVE_FLOPPY = 5;π EX_DRIVE_RAMDISK = 6;ππ{$IFNDEF TEST}πfunction GetDriveTypeEx (nDrive : integer) : integer;ππimplementationπuses windos, winprocs, wintypes;π{$ENDIF}ππ{π See the "MS-DOS Programmer's Reference" for further informationπ about this structure. It is the structure returned with an IOCTLπ $0D function, $60 subfunction (get device parameters).π}πtypeπ DeviceParams = recordπ bSpecFunc : byte; { Special functions }π bDevType : byte; { Device type }π wDevAttr : word; { Device attributes }π wCylinders : word; { Number of cylinders }π bMediaType : byte; { Media type }π { Beginning of BIOS parameter block (BPB) }π wBytesPerSec : word; { Bytes per sector }π bSecPerClust : byte; { Sectors per cluster }π wResSectors : word; { Number of reserved sectors }π bFATs : byte; { Number of FATs }π wRootDirEnts : word; { Number of root-directory entries }π wSectors : word; { Total number of sectors }π bMedia : byte; { Media descriptor }π wFATsecs : word; { Number of sectors per FAT }π wSecPerTrack : word; { Number of sectors per track }π wHeads : word; { Number of heads }π dwHiddenSecs : longint; { Number of hidden sectors }π dwHugeSectors : longint; { Number of sectors if wSectors == 0 }π { End of BIOS parameter block (BPB) }π end;ππfunction GetDeviceParameters (nDrive : integer; var dp : DeviceParams) : boolean;π(*π //-----------------------------------------------------------------π // GetDeviceParameters()π //π // Fills a DeviceParams struct with info about the given drive.π // Calls DOS IOCTL Get Device Parameters (440Dh, 60h) function.π //π // Parametersπ // nDrive Drive number 0 = A, 1 = B, 2 = C, and so on.π // dp A structure that will contain the drive's parameters.π //π // Returns TRUE if it succeeded, FALSE if it failed.π //-----------------------------------------------------------------π*)πvarπ r : TRegisters;πbeginπ fillchar(r,sizeof(r),#0); { clean up registers to avoid GPF }π r.ax := $440d; { IOCTL }π r.ch := $08; { block device }π r.cl := $60; { get device parameters }π r.bx := nDrive + 1; { 1 = A:, 2 = B:, etc... }π r.ds := seg(dp); r.dx := ofs(dp); { where... }π msdos(r);π GetDeviceParameters := (r.flags and fCarry) = 0πend;ππfunction IsCDRomDrive (nDrive : integer) : boolean;π(*π //-----------------------------------------------------------------π // IsCDRomDrive()π //π // Determines if a drive is a CD-ROM. Calls MSCDEX and checksπ // that MSCDEX is loaded, and that MSCDEX reports the drive is aπ // CD-ROM.π //π // Parametersπ // nDrive Drive number 0 = A, 1 = B, 2 = C, and so forth.π //π // Returns TRUE if nDrive is a CD-ROM drive, FALSE if it isn't.π //-----------------------------------------------------------------π*)πvarπ r : TRegisters;πbeginπ fillchar(r,sizeof(r),#0); { clean up registers to avoid GPF andπ to ensure that BX = $ADAD would notπ be by accident }π r.ax := $150b; { MSCDEX installation check }π {π This function returns whether or not a drive letter is a CD-ROMπ drive supported by MSCDEX. If the extensions are installed, BXπ will be set to ADADh. If the drive letter is supported byπ MSCDEX, then AX is set to a non-zero value. AX is set to zeroπ if the drive is not supported. One must be sure to check theπ signature word to know that MSCDEX is installed and that AXπ has not been modified by another INT 2Fh handler.π }π r.cx := nDrive; { 0 = A:, 1 = B:, etc... }π intr ($2f, r); { do it }π IsCDRomDrive := (r.bx = $adad) and (r.ax <> 0)πend;ππ(*π //-----------------------------------------------------------------π // GetDriveTypeEx()π //π // Determines the type of a drive. Calls Windows's GetDriveTypeπ // to determine if a drive is valid, fixed, remote, or removeable,π // then breaks down these categories further to specific deviceπ // types.π //π // Parametersπ // nDrive Drive number 0 = A, 1 = B, 2 = C, etc.π //π // Returns one of:π // EX_DRIVE_INVALID -- Drive not detectedπ // EX_DRIVE_REMOVABLE -- Unknown removable-media type driveπ // EX_DRIVE_FIXED -- Hard disk driveπ // EX_DRIVE_REMOTE -- Remote drive on a networkπ // EX_DRIVE_CDROM -- CD-ROM driveπ // EX_DRIVE_FLOPPY -- Floppy disk driveπ // EX_DRIVE_RAMDISK -- RAM diskπ //-----------------------------------------------------------------π*)πfunction GetDriveTypeEx (nDrive : Integer) : integer;πvarπ dp : DeviceParams;π utype : integer;πbeginπ fillchar (dp, sizeof(dp), #0); { clear the DPB }π uType := GetDriveType(nDrive); { make a rough guess }π case uType ofππ DRIVE_REMOTE:π { GetDriveType() reports CD-ROMs as Remote drives. Needπ to see if the drive is a CD-ROM or a network drive. }π if IsCDRomDrive (nDrive)π then GetDriveTypeEx := EX_DRIVE_CDROMπ else GetDriveTypeEx := EX_DRIVE_REMOTE;ππ DRIVE_REMOVABLE:π {π Check for a floppy disk drive. If it isn't, then weπ don't know what kind of removable media it is.π For example, could be a Bernoulli box or something new...ππ DOS 6.0 Reference says devicetype 0=320/360kb floppy,π 1=1.2Mb, 2=720kb, 3=8" single density, 4=8" double density,π 7=1.44Mb, 8=optical, 9=2.88Mb. Code in Q105922 didn't pickπ up bDevType=9.π }π if GetDeviceParameters (nDrive, dp) and (dp.bDevType in [0..4,7..9])π then GetDriveTypeEx := EX_DRIVE_FLOPPYπ else GetDriveTypeEx := EX_DRIVE_REMOVABLE;ππ DRIVE_FIXED:π {π GetDeviceParameters returns a device type of 0x05 forπ hard disks. Because hard disks and RAM disks are the twoπ types of fixed-media drives, we assume that any fixed-π media drive that isn't a hard disk is a RAM disk.π }π if GetDeviceParameters (nDrive, dp) and (dp.bDevType = 5)π then GetDriveTypeEx := EX_DRIVE_FIXEDπ else GetDriveTypeEx := EX_DRIVE_RAMDISK;ππ elseπ GetDriveTypeEx := EX_DRIVE_INVALIDπ endπend;ππ{$IFDEF TEST}πvarπ i, d : integer;πbeginπ for i := 0 to 25π do beginπ d := GetDriveTypeEx(i);π if d <> EX_DRIVE_INVALIDπ then beginπ write (chr(i + ord('A')), ': ');π case GetDriveTypeEx(i) ofπ EX_DRIVE_REMOVABLE: Writeln ('Removable');π EX_DRIVE_FIXED: Writeln ('Harddisk');π EX_DRIVE_REMOTE: Writeln ('Network');π EX_DRIVE_CDROM: Writeln ('CDROM');π EX_DRIVE_FLOPPY: Writeln ('Floppy');π EX_DRIVE_RAMDISK: Writeln ('RAMdisk')π endπ endπ endπ{$ENDIF}πend. 3 05-26-9406:10ALL ANDREW J. COOK Printer Controls SWAG9405 61 Kx {************************************************}π{ }π{ AJC Printer Unit for Windows }π{ }π{ Printer control constants/functions }π{ }π{ Author: Andrew J. Cook }π{ Omaha, NE }π{ CompuServe ID: 71331,501 }π{ }π{ Written: January 1994 }π{ }π{ Copyright: None! I hereby commit this unit }π{ to the public domain. }π{ }π{************************************************}ππ{************************************************}π{ }π{ New SetPageSize function added and changed }π{ margin code in SetPrintParams function. }π{ }π{ Modified by: }π{ Paul Mayer }π{ ZPAY Payroll Systems, Inc. }π{ St. Petersburg, FL }π{ CompuServe ID: 76711,1141 }π{ }π{ Thanks to Kurt Barthelmess Borland Team B for }π{ pointing out what I was doing wrong so I }π{ could get this function to work after a week }π{ of trial and error and a lot of test paper! }π{ }π{ April 1994 }π{ }π{************************************************}ππunit AJCPrntW;ππ{$F+,O+,S-}ππinterfaceππuses WinTypes, WinProcs, OPrinter;ππtypeπ PAJCPrinter = ^TAJCPrinter;π TAJCPrinter = object(TPrinter)π function SetPageOrientation(Orientation: Integer): Integer; virtual;π function SetPageSize(PageID, NewLength, NewWidth : Integer) : Integer; virtual;π end;ππconstπ pm_Size = 1;π pm_Print = 2;ππtypeπ PAJCPrintOut = ^TAJCPrintOut;π TAJCPrintOut = object(TPrintOut)π VUnitsPerInch: Integer;π HUnitsPerInch: Integer;π LMarginUnits: Integer;π TMarginUnits: Integer;π RMarginUnits: Integer;π BMarginUnits: Integer;π OriginalAlignmentOptions: Word;π constructor Init(ATitle: PChar);π destructor Done; virtual;π procedure SetPrintParams(ADC: HDC; ASize: TPoint); virtual;π function VLogPos(Pos: Integer): Integer; virtual;π function HLogPos(Pos: Integer): Integer; virtual;π function VInches(Inches: Real): Integer; virtual;π function HInches(Inches: Real): Integer; virtual;π function Points(APoints: Integer): Integer; virtual;π function PrintHeader(Mode, Page: Word): Integer; virtual;π function PrintFooter(Mode, Page: Word): Integer; virtual;π procedure JustifyLeft;π procedure JustifyCenter;π procedure JustifyRight;π end;ππvarπ DevModeOut, DevModeIn : PDevMode;ππimplementationππfunction TAJCPrinter.SetPageOrientation(Orientation: Integer): Integer;πvarπ DevMode: PDevMode;π Result: Integer;πbeginπ SetPageOrientation := -1;π if (Orientation <> dmOrient_Portrait) andπ (Orientation <> dmOrient_Landscape) thenπ exit;π if @ExtDeviceMode = nil then exit;π if DevSettings^.dmFields or dm_Orientation = 0 then exit;ππ if DevSettings^.dmOrientation = Orientation thenπ beginπ SetPageOrientation := 1;π exit;π end;ππ GetMem(DevMode, DevSettingSize);π Move(DevSettings^, DevMode^, DevSettingSize);π DevMode^.dmOrientation := Orientation;π Result := ExtDeviceMode(0, DeviceModule, DevSettings^, Device, Port,π DevMode^, nil, dm_In_Buffer or dm_Out_Buffer);π FreeMem(DevMode, DevSettingSize);π if Result = IDOK thenπ SetPageOrientation := 0;πend;ππfunction TAJCPrinter.SetPageSize(PageID, NewLength, NewWidth : Integer): Integer;πvarπ DevModeIn: PDevMode;π Result: Integer;π Size : Integer;πbeginπ SetPageSize := -1;π if @ExtDeviceMode = nil then exit;π GetMem(DevModeIn, DevSettingSize);π Result := ExtDeviceMode(0, DeviceModule, DevSettings^, Device, Port,π DevModeIn^, nil, dm_Out_Buffer);π DevModeIn^.dmDeviceName := DevSettings^.dmDeviceName;π DevModeIn^.dmSpecVersion := DevSettings^.dmSpecVersion;π DevModeIn^.dmDriverVersion := 0;π DevModeIn^.dmFields := dm_PaperSize or dm_Paperlength or dm_PaperWidth;π DevModeIn^.dmPaperSize := PageId {eg dmPaper_User, dmPaper_Letter};π DevModeIn^.dmPaperLength := NewLength; {in 1/10 of millimeters}π DevModeIn^.dmPaperWidth := NewWidth {in 1/10 of millimeters};π Result := ExtDeviceMode(0, DeviceModule, DevSettings^, Device, Port,π DevModeIn^, nil, dm_In_Buffer or dm_Out_Buffer);π FreeMem(DevModeIn, DevModeIn^.dmSize + DevModeIn^.dmDriverExtra);π if Result = IDOK thenπ SetPageSize := 0;πend;ππconstructor TAJCPrintOut.Init(ATitle: PChar);πbeginπ inherited Init(ATitle);π OriginalAlignmentOptions := 0;πend;ππdestructor TAJCPrintOut.Done;πbeginπ if OriginalAlignmentOptions <> 0 thenπ SetTextAlign(DC, OriginalAlignmentOptions);ππ inherited Done;πend;ππprocedure TAJCPrintOut.SetPrintParams(ADC: HDC; ASize: TPoint);πvarπ lpOffset, lpDimensions : TPoint;πbeginπ inherited SetPrintParams(ADC, ASize);ππ OriginalAlignmentOptions := GetTextAlign(DC);ππ VUnitsPerInch := GetDeviceCaps(DC, LogPixelsY);π HUnitsPerInch := GetDeviceCaps(DC, LogPixelsX);ππ Escape(DC, GetPhysPageSize, 0, nil, @lpDimensions);π Escape(DC, GetPrintingOffset, 0, nil, @lpOffset);ππ TMarginUnits := lpOffset.Y;π LMarginUnits := lpOffset.X;π BMarginUnits := (lpDimensions.Y - (Size.Y+lpOffset.Y));π RMarginUnits := (lpDimensions.X - (Size.X+lpOffset.X));πend;ππfunction TAJCPrintOut.VLogPos(Pos: Integer): Integer;πbeginπ if Pos < 0 thenπ VLogPos := Size.Y + Pos + TMarginUnitsπ elseπ VLogPos := Pos - TMarginUnits;πend;πππfunction TAJCPrintOut.HLogPos(Pos: Integer): Integer;πbeginπ if Pos < 0 thenπ HLogPos := Size.X + Pos + LMarginUnitsπ elseπ HLogPos := Pos - LMarginUnits;πend;ππfunction TAJCPrintOut.VInches(Inches: Real): Integer;πbeginπ VInches := round(Inches * VUnitsPerInch);πend;ππfunction TAJCPrintOut.HInches(Inches: Real): Integer;πbeginπ HInches := round(Inches * HUnitsPerInch);πend;ππfunction TAJCPrintOut.Points(APoints: Integer): Integer;πbeginπ Points := APoints * (VUnitsPerInch) div 72;πend;ππfunction TAJCPrintOut.PrintHeader(Mode, Page: Word): Integer;πbeginπ PrintHeader := 0;πend;ππfunction TAJCPrintOut.PrintFooter(Mode, Page: Word): Integer;πbeginπ PrintFooter := 0;πend;ππprocedure TAJCPrintOut.JustifyLeft;πvarπ AlignmentOptions: Word;πbeginπ AlignmentOptions := GetTextAlign(DC);π AlignmentOptions := AlignmentOptions and not (ta_left or ta_center or ta_right);π AlignmentOptions := AlignmentOptions or ta_left;π SetTextAlign(DC, AlignmentOptions);πend;ππprocedure TAJCPrintOut.JustifyCenter;πvarπ AlignmentOptions: Word;πbeginπ AlignmentOptions := GetTextAlign(DC);π AlignmentOptions := AlignmentOptions and not (ta_left or ta_center or ta_right);π AlignmentOptions := AlignmentOptions or ta_center;π SetTextAlign(DC, AlignmentOptions);πend;ππprocedure TAJCPrintOut.JustifyRight;πvarπ AlignmentOptions: Word;πbeginπ AlignmentOptions := GetTextAlign(DC);π AlignmentOptions := AlignmentOptions and not (ta_left or ta_center or ta_right);π AlignmentOptions := AlignmentOptions or ta_right;π SetTextAlign(DC, AlignmentOptions);πend;πππbeginπend.π 4 05-26-9407:31ALL MORTEN WELINDER 32bit Protected Mode SWAG9405 73 Kx {π>What you *can* do is these things.ππ>1. You can modify the limit of a selector from $0000FFFF toπ> $xxxxFFFF so assembler code can use 32-bit addressing.π> Note that you may not change the lower 16-bit of the limitπ> field, or else the DPMI server crashes.ππ>2. You can compile a 32-bit assembler procedure into yourπ> program. It just needs a tiny (16 byte) wrapper and mustπ> reside in the low 64K of a segment (or else interruptsπ> cannot return correctly). However, the BP linker doesπ> not support 32-bit fixups so there are limits as to whatπ> you can put into the assembler code.ππ>3. If you are willing to give up assembler access to BPπ> variables, then you can make a binary image and linkπ> that into your program. Then you can do whatever pleasesπ> you in the assembler procedure.ππ>If there is interrest, I could post an example routine showingπ>this.ππThree files are needed: a batch file for assembly, an assemblerπfile with 32-bit code, and a pascal test program. The testπprogram is not supposed to do anything useful.ππThe code is unsupported. You must know what you're doing.πYou'll need the `exe2bin' or `exetobin' utility; you'll needπBP7 (with Turbo Assembler, and you cannot use TP7). You mustπbe using Borland's DPMI or some DPMI that supports 32-bitπprograms. Don't even think about running this on a 286. Whenπthings go wrong it's not my fault. Don't tell me you know aπbetter way to get the segment limit, because so do I.ππMorten Welinderπterra@diku.dkππ{ THE BATCH FILE }π{ CUT HERE }π{***************************************************************************}ππ@Echo OffπTasm /M2 /T /L Test32πIf Not Exist Test32.Obj Goto EndπTlink /x test32 >NulπExe2bin Test32.Exe Test32.BinπRem Del Test32.ExeπDel Test32.Objπ:Endππ{ THE ASSEMBLER PROGRAM }π{ CUT HERE }π{***************************************************************************}ππ; ---------------------------------------------------------------------------π; Example 32 bit program for use with Borland Pascal 7.0π; ---------------------------------------------------------------------------πIdeal ; (Keep Tasm happy)πP386πModel Use32 Huge,PascalπSegment Code Use32πAssume Cs:Codeπ; ---------------------------------------------------------------------------πEntry0: Movzx Eax,[Word Esp] ; Change the stack frame to 32 bitsπ Shr [Dword Esp],16 ; so [Esp+xxx] works as expected.π Push Eaxπ Jmp P0πAlign 10hπEntry1: Movzx Eax,[Word Esp] ; Aligned 10h for speed.π Shr [Dword Esp],16π Push Eaxπ Jmp P1πAlign 10hπEntry2: Movzx Eax,[Word Esp] ; Aligned 10h for speed.π Shr [Dword Esp],16π Push Eaxπ Jmp P2π; etc.π; ---------------------------------------------------------------------------πAlign 10hπProc P0 Far L1:Dword,L2:Dwordπ Mov Eax,[L1] ; Add the parametersπ Add Eax,[L2]ππ Shld Edx,Eax,16 ; Output is left in Dx:Axπ RetπEndpπ; ---------------------------------------------------------------------------πAlign 10hπProc P1 Farπ Push Ds ; Call MsDos from a 32 bit segmentπ Mov Ax,Cs ; Never ever perform a softwareπ Mov Ds,Ax ; interrupt if Ip>=64K!π Mov Ah,9π Mov Edx,Offset Messageπ Int 21hπ Pop Dsπ RetππMessage Db 'Hello, 32 bit world!',13,10,'$'πEndpπ; ---------------------------------------------------------------------------πAlign 10hπProc P2 Far P:Dwordπ Push Dsπ Xor Esi,Esiπ Lds Si,[Small P]π Mov Ecx,20000h/4π @@1: Mov [Esi],Esiπ Add Esi,4π Loop @@1π Pop Dsπ RetπEndpπ; ---------------------------------------------------------------------------πEndsπEndππ{ THE TEST PROGRAM }π{ CUT HERE }π{***************************************************************************}ππProgram Test;π{ ------------------------------------------------------------------------- }πUses Winapi, Dos;π{ ------------------------------------------------------------------------- }πConst Dpmi_32BitSegment = $4000;ππType Dpmi_Descriptor = Recordπ Limit0015 : Word;π Base0015 : Word;π Base1623 : Byte;π Rights : Byte; { 7=Prsnt, 6-5=Dpl, 4=App, }π { 3-0=Type }π Rights386 : Byte; { 7=Gran, 6=Size32, 5=0, }π { 4=Avail, 3-0=Limit1619 }π Base2431 : Byte;π End;ππVar Sel : Word;π Oldright : Word;π ProcPtr : Pointer;π P1 : Function(L1,L2: LongInt): LongInt;π P2 : Procedure;π P3 : Procedure(P: Pointer);π Fil : File;π Data : Pointer;π Dsel : Word;π{ ------------------------------------------------------------------------- }πProcedure Dpmi_SetSelectorLimit(Sel: Word; Limit: LongInt); Assembler;πAsm Mov Ax,0008Hπ Mov Bx,[Sel]π Mov Dx,[Word Ptr Limit]π Mov Cx,[Word Ptr Limit+2]π Int 31HπEnd;π{ ------------------------------------------------------------------------- }πProcedure Dpmi_GetDescriptor(Sel: Word; Var Buffer: Dpmi_Descriptor); Assembler;πAsm Mov Ax,000Bhπ Mov Bx,[Sel]π Les Di,[Buffer]π Int 31HπEnd;π{ ------------------------------------------------------------------------- }πProcedure Dpmi_SetDescriptor(Sel: Word; Var Buffer: Dpmi_Descriptor); Assembler;πAsm Mov Ax,000Chπ Mov Bx,[Sel]π Les Di,[Buffer]π Int 31HπEnd;π{ ------------------------------------------------------------------------- }πFunction Dpmi_GetAccessRights(Sel: Word): Word; Assembler;πVar Buffer : Dpmi_Descriptor;πAsm Mov Bx,[Sel]π Push Bxπ Push Ssπ Lea Di,[Buffer]π Push Diπ Call Dpmi_GetDescriptorπ Mov Ax,[Word Ptr Buffer+5]πEnd;π{ ------------------------------------------------------------------------- }πProcedure Dpmi_SetAccessRights(Sel: Word; Rights: Word); Assembler;πVar Buffer : Dpmi_Descriptor;πAsm Mov Bx,[Sel]π Lea Di,[Buffer]π Push Bxπ Push Ssπ Push Diπ Push Bxπ Push Ssπ Push Diπ Call Dpmi_GetDescriptorπ Mov Ax,[Word Ptr Buffer+5]π And Ax,8F00hπ Mov Bx,[Rights]π And Bx,50Ffhπ Or Ax,Bxπ Mov [Word Ptr Buffer+5],Axπ Call Dpmi_SetDescriptorπEnd;π{ ------------------------------------------------------------------------- }πFunction Dpmi_GetSelectorLimit(Sel: Word): LongInt; Assembler;πVar Buffer : Dpmi_Descriptor;πAsm Mov Bx,[Sel]π Push Bxπ Push Ssπ Lea Di,[Buffer]π Push Diπ Call Dpmi_GetDescriptorπ Mov Dx,[Word Ptr Buffer+6]π Mov Ax,[Word Ptr Buffer]π Test Dl,80Hπ Je @@3π Mov Bx,Axπ Mov Cl,4π Shr Bx,Clπ Mov Cl,12π Shl Dx,Clπ Shl Ax,Clπ Or Dx,Bxπ Or Ax,0Fffhπ Jmp @@2π @@3: And Dx,0Fhπ Jmp @@2π @@1: Mov Ax,0π Mov Dx,0π @@2:πEnd;π{ ------------------------------------------------------------------------- }πFunction Int2HexN(L: LongInt; N:Integer): String;πConst Digits : Array[0..15] Of Char = '0123456789ABCDEF';πVar S : String;πBeginπ S:='';π While N>0 Do Beginπ S:=Digits[L And $F]+S;π Dec(N);π L:=L Shr 4;π End;π Int2HexN:=S;πEnd;π{ -------------------------------------------------------------------------- }πππBeginπ Data:=GlobalallocPtr(Gmem_Zeroinit,$20000);π Dsel:=Seg(Data^);π Dpmi_SetSelectorLimit(Dsel,$1FFFF);ππ GetMem(ProcPtr,$4000);π Assign(Fil,'Test32.Bin');π Reset(Fil,1);π BlockRead(Fil,ProcPtr^,FileSize(Fil));π Close(Fil);π LongInt(@P1):=(LongInt(ProcPtr)+0*16);π LongInt(@P2):=(LongInt(ProcPtr)+1*16);π LongInt(@P3):=(LongInt(ProcPtr)+2*16);ππ Sel:=Seg(ProcPtr^);π Oldright:=Dpmi_GetAccessRights(Sel);π Dpmi_SetAccessRights(Sel,(Oldright Or Dpmi_32BitSegment) And $FFF1+$A);ππ Writeln('Proc: ',Int2HexN(Sel,4),':',Int2HexN(Ofs(ProcPtr^),8));π Writeln('Base: ',Int2HexN(Getselectorbase(Sel),8));π Writeln('Limit: ',Int2HexN(Dpmi_GetSelectorLimit(Sel),8));π Writeln('Rights: ',Int2HexN(Dpmi_GetAccessRights(Sel),4));π Writeln;π Writeln('Data: ',Int2HexN(Seg(Data^),4),':',Int2HexN(Ofs(Data^),8));π Writeln('Base: ',Int2HexN(Getselectorbase(Dsel),8));π Writeln('Limit: ',Int2HexN(Dpmi_GetSelectorLimit(Dsel),8));π Writeln('Rights: ',Int2HexN(Dpmi_GetAccessRights(Dsel),4));π Writeln;π Writeln('Ss:Sp: ',Int2HexN(SSeg,4),':',Int2HexN(SPtr,4));ππ Writeln('Result: ',Int2HexN(P1($12345678,$87654321),8));π P2;π P3(Data);ππ Dpmi_SetAccessRights(Sel,Oldright);π Dpmi_SetSelectorLimit(Dsel,$FFFF);π GlobalfreePtr(Data);πEnd.ππ 5 05-26-9407:31ALL MICHAEL VINCZE New EXE Headers SWAG9405 104 Kx (*πIn article 767298319@stimpy.cs.iastate.edu, james@cs.iastate.edu (James N. Potts) writes:π>I know that if you place {$D string} in a program, the string will be placedπ>into the executable. Is there an easy way to find this information, or doπ>you have to do a search through the file?ππThere are a few ways. Screen savers use this information, so one wayπto do it is to rename your file *.scr, place it in the windows directory,πand then look at it from the control panel as you are selecting a screenπsaver. Yeach! Another way is to use a file dumper (?) such asπTDUMP by Borland or EXEHDR by Microsoft. These programs will give youπthe pertinent information. TDUMP by the way comes with BP 7.0.ππProgrammaticly you can obtain the string through the new executableπfile header information. The string you are interested in is theπfirst entry in the nonresident-name table. If you do not specifyπ{$D string} then this string will be the file name (like myfile.EXE).ππA few days ago I posted how to do certain things with the new executableπfile header. You may want to look back a few days on your news readerπto get some insight. But don't dispare. I will give some clues here.ππThe first thing to do is to read the new EXE file format foundπin the Borland or Micrsoft help files. For Borland it canπbe found under the "File Formats" topic.ππNext you should get the EXE header types. This can be obtainedπat ftp.microsoft.com (filename: newexe12.zip). I haveπincluded a Pascal version at the end of this missive.ππNow in your program you need to do the following:ππ 1. Determine if the file is of the new EXE type.π 2. Get the address of the non-resident name table.π 3. Read the first string in the non-resident name table.ππLater in this missive you will find a function that does step 1.πBelow are the stepsπ*)ππusesπ WinCrt,π WinTypes,π WinProcs;ππconstπ fn: PChar = 'c:\bp\myprog\myprog.exe';ππtypeπ DosHdr : IMAGE_DOS_HEADER;π NewHdr : IMAGE_NEW_HEADER;π ModuleDescription: rsrc_string;π Filehandle : Integer;π ofs : TOFSTRUCT;ππlabelπ Return;ππbeginπif not IsNewExe (fn, DosHdr, NewHdr) then goto Return;ππFillChar (ofs, sizeof (TOFSTRUCT), 0);πif OpenFile (fn, ofs, OF_EXIST or OF_READ) = -1 then goto Return;ππFileHandle := OpenFile (fn, ofs, OF_REOPEN or OF_READ);πif FileHandle = -1 then goto Return;ππ{ goto location of non-resident name table }π_llseek (FileHandle, DosHdr.e_lfanew + NewHdr.ne_nrestab, 0);ππ{ read length of string (in first entry of the non-resident name table) }π_lread (FileHandle, @ModuleDescription.rs_len, sizeof (Byte));ππ{ allocate space for string }πGetMem (ModuleDescription.rs_string, ModuleDescription.rs_len + 1);ππ{ read module description string }π_lread (FileHandle, @ModuleDescription.rs_string, ModuleDescription.rs_len);ππ{ tag null termination onto string }πModuleDescription.rs_string[ModuleDescription.rs_len] := #0;ππ{ write results }πwriteln (fn, ' Module Description: ', ModuleDescription.rs_string);ππ{ dispose of string }πFreeMem (ModuleDescription.rs_string, ModuleDescription.rs_len + 1);ππReturn:π{ close file }π_lclose (FileHandle);πend.πππNote that the above code is only good for finding the first stringπin the non-resident name table as the rest of the table also includesπindex numbers as wll as the string length and the string. This codeπhas also not been tested.ππI hope you get some mileage from it.ππ-Michael Vinczeπvincze@lobby.ti.comππ---------- NEW EXE HEADER TYPES ----------ππtypeπ IMAGE_DOS_HEADER = record { DOS 1, 2, 3 .EXE header }π e_magic : Word; { Magic number }π e_cblp : Word; { Words on last page of file }π e_cp : Word; { Pages in file }π e_crlc : Word; { Relocations }π e_cparhdr : Word; { Size of header in paragraphs }π e_minalloc: Word; { Minimum extra paragraphs needed }π e_maxalloc: Word; { Maximum extra paragraphs needed }π e_ss : Word; { Initial (relative) SS value }π e_sp : Word; { Initial SP value }π e_csum : Word; { Checksum }π e_ip : Word; { Initial IP value }π e_cs : Word; { Initial (relative) CS value }π e_lfarlc : Word; { File address of relocation table }π e_ovno : Word; { Overlay number }π e_res : array[0..3] of Word; { Reserved words }π e_oemid : Word; { OEM identifier (for e_oeminfo) }π e_oeminfo : Word; { OEM information; e_oemid specific }π e_res2 : array[0..9] of Word; { Reserved words }π e_lfanew : Longint; { File address of new exe header }π end;ππconstπ IMAGE_DOS_SIGNATURE = $00005A4D; { MZ }π IMAGE_OS2_SIGNATURE = $0000454E; { NE }π IMAGE_OS2_SIGNATURE_LE = $00005A4D; { LE }π IMAGE_NT_SIGNATURE = $00004550; { PE00 }ππtypeπ IMAGE_NEW_HEADER = record { New .EXE header }π ne_magic : Word; { Magic number NE_MAGIC }π ne_ver : Byte; { Version number }π ne_rev : Byte; { Revision number }π ne_enttab : Word; { Offset of Entry Table }π ne_cbenttab : Word; { Number of bytes in Entry Table }π ne_crc : Longint; { Checksum of whole file }π ne_flags : Word; { Flag word }π ne_autodata : Word; { Automatic data segment number }π ne_heap : Word; { Initial heap allocation }π ne_stack : Word; { Initial stack allocation }π ne_csip : Longint; { Initial CS:IP setting }π ne_sssp : Longint; { Initial SS:SP setting }π ne_cseg : Word; { Count of file segments }π ne_cmod : Word; { Entries in Module Reference Table }π ne_cbnrestab : Word; { Size of non-resident name table }π ne_segtab : Word; { Offset of Segment Table }π ne_rsrctab : Word; { Offset of Resource Table }π ne_restab : Word; { Offset of resident name table }π ne_modtab : Word; { Offset of Module Reference Table }π ne_imptab : Word; { Offset of Imported Names Table }π ne_nrestab : Longint; { Offset of Non-resident Names Table }π ne_cmovent : Word; { Count of movable ent }π ne_align : Word; { Segment alignment shift count }π ne_cres : Word; { Count of resource entries }π ne_exetyp : Byte; { Target operating system }π ne_flagsothers: Byte; { Other .EXE flags }π ne_res : array [0..7] of Byte; { Pad structure to 64 bytes }π end;ππconst { Format of ne_exetyp (target operating system) }π NE_UNKNOWN = $0; { Unknown (any "new-format" OS) }π NE_OS2 = $1; { Microsoft/IBM OS/2 }π NE_WINDOWS = $2; { Microsoft Windows }π NE_DOS4 = $3; { Microsoft MS-DOS 4.x }π NE_DEV386 = $4; { Microsoft Windows 386 }ππconst { Format of IMAGE_NEW_HEADER.ne_flags }π NENOTP = $8000; { Not a process }π NEIERR = $2000; { Errors in image }π NEBOUND = $0800; { Bound as family app }π NEAPPTYP = $0700; { Application type mask }π NENOTWINCOMPAT = $0100; { Not compatible with P.M. Windowing }π NEWINCOMPAT = $0200; { Compatible with P.M. }π NEWINAPI = $0300; { Uses P.M. Windowing API }π NEFLTP = $0080; { Floating-point instructions }π NEI386 = $0040; { 386 instructions }π NEI286 = $0020; { 286 instructions }π NEI086 = $0010; { 8086 instructions }π NEPROT = $0008; { Runs in protected mode only }π NEPPLI = $0004; { Per-Process Library Initialization }π NEINST = $0002; { Instance data }π NESOLO = $0001; { Solo data }ππtypeπ new_seg = record { New .EXE segment table entry }π ns_sector : Word; { File sector of start of segment }π ns_cbseg : Word; { Number of bytes in file }π ns_flags : Word; { Attribute flags }π ns_minalloc: Word; { Minimum allocation in bytes }π end;ππconst { Format of new_seg.nsflags }π NSCODE = $0000; { Code segment }π NSDATA = $0001; { Data segment }π NSLOADED = $0004; { ns_sector field contains memory addr }π NSTYPE = $0007; { Segment type mask }π NSITER = $0008; { Iterated segment flag }π NSMOVE = $0010; { Movable segment flag }π NSSHARED = $0020; { Shared segment flag }π NSPRELOAD = $0040; { Preload segment flag }π NSEXRD = $0080; { Execute-only (code segment), or read-only (data segment) }π NSRELOC = $0100; { Segment has relocations }π NSCONFORM = $0200; { Conforming segment }π NSDISCARD = $1000; { Segment is discardable }π NS32BIT = $2000; { 32-bit code segment }π HSHUGE = $4000; { Huge memory segment }π NSEXPDOWN = $0200; { Data segment is expand down }ππ(*π#define NSDPL 0x0C00 /* I/O privilege level (286 DPL bits) */π#define SHIFTDPL 10 /* Left shift count for */π#define NSPURE NSSHARED /* For compatibility */π#define NSALIGN 9 /* Segment data aligned on 512 byte boundaries */π*)ππtypeπ new_rlcinfo = record { Relocation info }π nr_nreloc: Word; { number of relocation items that follow }π end;ππtypeπ new_rlc = record { Relocation item }π nr_stype: Byte; { Source type }π nr_flags: Byte; { Flag byte }π nr_soff : Word; { Source offset }π case Integer ofπ 0: (nr_segno : Byte; { Target segment number } { internal reference }π nr_res : Byte; { Reserved }π nr_entry : Word); { Target Entry Table offset }π 1: (nr_mod : Word; { Index into Module Reference Table } { import }π nr_proc : Word); { Procedure ordinal or name offset }π 2: (nr_ostype: Word; { OSFIXUP type } { operating system fixup }π nr_osres : Word); { Reserved }π end;ππ{ Resource type or name stringπ}πtypeπ rsrc_string = recordπ rs_len : Byte; { number of bytes in string }π rs_string: PChar; { text of string }π end;πππ---------- IsNewExe() function ----------ππBelow is the code to determine if the file is of the new EXE type.πNote how DosHdr and NewHdr are passed by reference and not by value.πThis is so values for DosHdr and NewHdr can be used by otherπfunctions called by the main program. Also note the extensive useπof the OpenFile(), _lread(), _llseek(), and _lclose() functions.ππ function IsNewExe (fn: PChar;π var DosHdr: IMAGE_DOS_HEADER;π var NewHdr: IMAGE_NEW_HEADER): Boolean;π labelπ Return;π varπ Filehandle: Integer;π BytesRead : Integer;π ofs : TOFSTRUCT;π beginπ IsNewExe := False;ππ FillChar (ofs, sizeof (TOFSTRUCT), 0);π if OpenFile (fn, ofs, OF_EXIST or OF_READ) = -1 then goto Return;ππ FileHandle := OpenFile (fn, ofs, OF_REOPEN or OF_READ);π if FileHandle = -1 then goto Return;ππ FillChar (DosHdr, sizeof (IMAGE_DOS_HEADER), 0);π FillChar (NewHdr, sizeof (IMAGE_NEW_HEADER), 0);ππ { read MS-DOS header }π BytesRead := _lread (FileHandle, @DosHdr, sizeof (IMAGE_DOS_HEADER));ππ { test for bytes read }π if BytesRead <> sizeof (IMAGE_DOS_HEADER) then goto Return;ππ { test for magic number MZ }π if DosHdr.e_magic <> IMAGE_DOS_SIGNATURE then goto Return;ππ { test for address of new exe header }π if DosHdr.e_lfanew <= 0 then goto Return;ππ { fast forward to Windows header }π if _llseek (FileHandle, DosHdr.e_lfanew, 0) = -1 then goto Return;ππ { read new exe header }π BytesRead := _lread (FileHandle, @NewHdr, sizeof (IMAGE_NEW_HEADER));ππ { test for bytes read }π if BytesRead <> sizeof (IMAGE_NEW_HEADER) then goto Return;ππ { test for signature NE }π if NewHdr.ne_magic <> IMAGE_OS2_SIGNATURE then goto Return;ππ { passed the test }π IsNewExe := True;ππ Return:π { close file }π _lclose (FileHandle);π end;ππ 6 05-26-9410:57ALL DANIEL THOMAS Center Dialog SWAG9405 29 Kx Unit Center;π{**************************************************************************}π{* Center by Daniel Thomas CIS 72301,2164 *}π{* *}π{* This code is hereby donated to the public domain. Enjoy. *}π{* *}π{* This unit contains a procedure, CenterPopup, which will center a *}π{* Popup window (i.e. a dialog) in it's parent's window. If it won't *}π{* fit inside the parent's window, then it will be centered on top of *}π{* the parent. *}π{* *}π{* Also, if the dialog would be positioned off the screen, it is forced *}π{* within the visible screen. *}π{* *}π{* There are a few descendant objects - tCenteredDialog and *}π{* tCenteredInputDialog - that make using it a snap. Just replace an *}π{* occurrance of pDialog with pCenteredDialog, and you've got a centered *}π{* dialog! *}π{**************************************************************************}ππInterfaceππUSES WinTypes,WinProcs,WObjects,StdDlgs;ππTypeπ pInteger=^integer;ππ pCenteredDialog=^tCenteredDialog;π tCenteredDialog=object(tDialog)π Procedure SetupWindow; virtual;π end;ππ pCenteredInputDialog=^tCenteredInputDialog;π tCenteredInputDialog=object(tInputDialog)π Procedure SetupWindow; virtual;π end;ππProcedure CenterPopup(aPopup,aParent: hWnd);ππImplementationππProcedure CenterPopup(aPopup,aParent: hWnd);ππvarπ PopupR,ParentR : tRect;π ScreenW,ScreenH : integer;π x,y,π PopupW,PopupH,π ParentW,ParentH : word;ππ procedure SetupValues(Wnd: hWnd; var R: tRect; var W,H : word);π beginπ GetWindowRect(Wnd,R);π W := R.Right-R.Left;π H := R.Bottom-R.Top;π end; {SetupValues}ππ procedure SetupLocation(PopupSize,ScreenSize,ParentSize,ParentStart : word;π var PopupStart: word);π beginπ if PopupSize > ScreenSize thenπ PopupStart := 0π elseπ beginπ if PopupSize <= ParentSize thenπ PopupStart := ParentStart+((ParentSize-PopupSize) div 2)π elseπ PopupStart := ParentStart-((PopupSize-ParentSize) div 2);π if PopupStart > ScreenSize thenπ PopupStart := 0π elseπ if PopupStart+PopupSize > ScreenSize thenπ PopupStart := ScreenSize-PopupSize;π end;π end; {SetupLocation}ππbegin {CenterPopup}π ScreenW := GetSystemMetrics(sm_CXScreen);π ScreenH := GetSystemMetrics(sm_CYScreen);π SetupValues(aPopup,PopupR,PopupW,PopupH);π SetupValues(aParent,ParentR,ParentW,ParentH);π SetupLocation(PopupW,ScreenW,ParentW,ParentR.Left,x);π SetupLocation(PopupH,ScreenH,ParentH,ParentR.Top,y);π MoveWindow(aPopup,x,y,PopupW,PopupH,false);πend; {CenterPopup}ππProcedure tCenteredDialog.SetupWindow;ππbeginπ tDialog.SetupWindow;π CenterPopup(HWindow, Parent^.HWindow);πend; {tAniOptionsDialog.SetupWindow}ππProcedure tCenteredInputDialog.SetupWindow;ππbeginπ tInputDialog.SetupWindow;π CenterPopup(HWindow, Parent^.HWindow);πend; {tAniOptionsDialog.SetupWindow}ππππend.π 7 05-26-9411:03ALL RON AARON NO multiple instances SWAG9405 9 Kx program Instances;π{ uploaded by Ron Aaron as a demonstration of how toπ prevent multiple instances of a program in differentπ VMs. This program will work compiled for Windows, DOSπ or DPMI.π}πuses strings,π{$IFDEF WINDOWS}π wincrtπ{$ELSE}π crtπ{$ENDIF}π;ππvarπ { Inter Program Area: 16 bytes set aside by IBM forπ just this sort of thing...π }π IPA : array[0..15] of char absolute $40:$f0;ππconstπ ident : PChar = 'INSTTEST';ππfunction isrunning : boolean;πbeginπ if StrComp(IPA, ident) = 0 thenπ isrunning := trueπ elseπ isrunning := false;πend;ππprocedure install;πbeginπ StrCopy(IPA, ident);πend;ππprocedure deinstall;πbeginπ StrCopy(IPA,'xxxxx');πend;ππbeginπ if isrunning thenπ beginπ writeln('Previous copy is running.');π endπ elseπ beginπ install;π writeln('No previous copy is running. Press any key to quit...');π while not keypressed doπ ;π deinstall;π end;πend.
